#!/usr/bin/env perl

#------------------------------------------------------------------------------
# File:    extractsymset.pl
# Author:  Handre Groenwald, Marelie Davel
# Info:    Generate symbol set - works on the principle of longest string matching (lsm)
#          Note: only exact matches considered here - to be replaced by 
#                DP alignment in future.
#------------------------------------------------------------------------------

use strict;
use warnings;

#------------------------------------------------------------------------------

sub print_usage() {
  print "Generate symbol set from file containing word pairs\n";
  print "Usage: extractsymset.pl <in:txt> <out:symbols>\n";
  print "       <in:txt>       tab-separated word pairs\n";
  print "       <out:symbols>  generated symbols\n";
}

#------------------------------------------------------------------------------

sub lc_substr($$) {
  # Find longest common substring (lcs) of str1 and str2; 
  my ($str1, $str2) = @_;
  my $length_lcs = 0; 
  my $max1 = length $str1; 
  my $max2 = length $str2; 
  my @chars1 = split //, $str1;
  my @chars2 = split //, $str2;
  unshift @chars1, '';
  unshift @chars2, '';
  my @current_best; 
  my @current_options; 

  # Initialise array containing list of current best lengths at n1 and n2
  for my $n1 (0 .. $max1-1) {
    for my $n2 (0 .. $max2-1) {
      $current_best[$n1][$n2] = 0;
    }
  }
  for my $n1 ( 1 .. $max1 ) {
    for my $n2 ( 1 .. $max2 ) {
      if ($chars1[$n1] eq $chars2[$n2]) {
        $current_best[$n1][$n2] = $current_best[$n1-1][$n2-1] + 1;
        if ($current_best[$n1][$n2] > $length_lcs) {
          $length_lcs = $current_best[$n1][$n2];
          # We've found a longer string, ignore previous options
          @current_options = ();    
        }
         
        if ($current_best[$n1][$n2] == $length_lcs) {
          push @current_options, substr($str1, ($n1-$length_lcs), $length_lcs);
        }
      }
    }
  }
  return $current_options[0];
}

#------------------------------------------------------------------------------

sub do_extract($$) {
  my ($inName,$outName) = @_;
  open my $in, '<:encoding(utf8)', $inName or die "Cannot open $inName";
  open my $out, '>:encoding(utf8)', $outName or die "Cannot open $outName";
  
  while(<$in>) {
    chomp;
    s/ /#/g;
    s/'/@/g;
    s/-/%/g;
    my $line = lc;
    if ($line =~ /(.*)\t(.*)/){
      my $form1=$1;  
      my $form2=$2;
      chomp($form1);
      chomp($form2);
      print $out "$form1\t";
      if ($form2 eq "(o)") {           # periphrasis ('~')
        print $out "(~)";       
      } elsif ($form1 eq $form2) {      # zero derivation  ('=')
        print $out "(=)";
      } else { 

        #Do longest string matching 
        my ($form1_left, $form1_right, $form2_left, $form2_right) = ('','','','');
        my $lsm = lc_substr($form1,$form2);
        die "Prob with $lsm ($form1 to $form2)" if length($lsm)<=0;
   
        if ($form1 =~/(.*)$lsm(.*)/) {
          $form1_left=$1;
          $form1_right=$2;   
        } 
        if ($form2 =~/(.*)$lsm(.*)/) {
          $form2_left=$1;
          $form2_right=$2;   
        }
        
        # if portion of form1 or form2 to left of match
        if ((length($form1_left)>0) or (length($form2_left)>0)) { 
          print $out "L";
          print $out "$form1_left";
          print $out ">";
          print $out "$form2_left";
        }

        # if portion of form1 or form2 to right of match
        if ((length($form1_right)>0) or (length($form2_right)>0)) { 
          print $out "R";
          print $out "$form1_right";
          print $out ">";
          print $out "$form2_right";
        }
      }
      print $out "\t$form2\n";
    } else {
      print "Warning: line $line not processed\n";
    }
  } 
  close $in;
  close $out;
} 

#------------------------------------------------------------------------------

if (scalar @ARGV != 2) {
  print_usage();
  exit;
} else {
  do_extract($ARGV[0],$ARGV[1]);
}

#------------------------------------------------------------------------------
